module type GM = sig
  include Graph.Sig.I with type V.label = string*int
  module Mark : sig
    val get : V.t -> int
    val set : V.t -> int -> unit
  end
end

module type VM = sig
   module G :GM
   type t = string*int*(string list)
   val name :  t -> string
   val color : t -> int
   val succl : t -> int
end

module VertColorer (G : GM)(V : VM) = struct

open Graph

module Int = struct
type t = int
let equal = (=)
let hash = Hashtbl.hash
end

module H = Hashtbl.Make(Int)
module L = Logger.Logger(G)(V)
module S = Sort.Sort(V)

open V
open L
open S

open Graphviz.DotAttributes

let max_iter = ref 10
let debug = false

exception Except
exception Invalid_input_argument

let vertex_groups vertexes =     
    let sorted = List.fast_sort compare_by_color  vertexes in 
    List.fold_left (fun lst ((_,color,_)as v) -> 
                        match lst 
                        with
                        | (((_,c,_)::_)as v_gr)::tl2 -> if color = c 
                                                        then (v::v_gr)::tl2
                                                        else [v]::lst
                        | [] -> [[v]]
                        | _ -> raise Except
                   ) [] sorted
 
let one_iter v_gr (recolor_vrts,vrts) ((name,color,succ) as v)= 
    let get_color name = 
    (* (==) используется осознанно*)
        let (_,c,_) = try (List.find (fun (n,_,_) -> n==name) vrts) with _ -> (List.find (fun (n,_,_) -> n==name) recolor_vrts) in     
        c
    in 
    let check slst c = List.fold_left (fun flg name ->  flg & ((get_color name) != c)) true slst
    in
    let rec add gr = 
        match gr
        with
        | (c,l)::tl -> if color = c
                       then add tl
                       else if check succ c 
                            then (name,c,succ)
                            else add tl
        | []        -> v   
    in
    add v_gr

let iterate v_gr = 
    let vertexes = List.concat v_gr in
    let del_v vert_lst = 
        match vert_lst with
        | (c,1)::tl -> tl
        | (c,l)::tl-> (c,l-1)::tl
        | _ -> [] in
    let vertex_gr_info = List.map (fun x ->
                                       match x with
                                       |(_,c,_)::_  as lst  -> (c,List.length lst)
                                       | _                  -> raise Except) v_gr in
    (*и конкатинация не используется осознанно. так что-то около 2 .. 2.5 раза быстрее*)                                       
    fst(List.fold_left (fun (l,(vgr,vgrc)) v ->                            
                            let l1 = List.length l in
                            let pair = 
                                if l1 < 100
                                then ([],l@vgrc)
                                else 
                                     let l2 = List.length vgrc in
                                     if l2 <100
                                     then ([],vgrc@l)
                                     else if l1>l2
                                          then (vgrc,l)
                                          else (l,vgrc)
                            in   
                            (one_iter vgr (pair) v)::l,
                            (del_v vgr,List.tl vgrc)) ([],(vertex_gr_info,List.concat v_gr)) vertexes)


let map g vertexes = 
    let iter_f v =
        let (name,color) = G.V.label v in 
        let  n_v = List.find (fun v -> (V.name v) = name) vertexes in
        G.Mark.set v (V.color n_v)
    in
    G.iter_vertex iter_f g 

let rec do_iterate = 
    let iter_count = ref 0 in    
    let eff_iter_count = ref 0 in    
    let all_iter_count = ref 0 in    
    let sort_type_flg = ref true in
    fun vertexes -> (
    let compare_fun = 
        if (!sort_type_flg) 
        then compare_by_val 
        else compare_by_degree
    in
    let v_gr = List.fast_sort compare_fun (vertex_groups vertexes) in
    sort_type_flg := not(!sort_type_flg);
    let new_vertexes = iterate v_gr in
    let new_gr = vertex_groups new_vertexes in     
    if debug
    then( 
      print_string "group\n";
      print_vertex_group v_gr;    
      print_string "new_group\n";
      print_vertex_group new_gr;);
    if !iter_count = !max_iter
    then (new_vertexes,eff_iter_count,all_iter_count)
    else (let l = List.length new_gr in 
         (if (List.length v_gr) = l  
          then (incr iter_count;
                incr all_iter_count)
          else (iter_count:=0;
                Printf.printf "colors: %i \n" l;
                incr all_iter_count;
                incr eff_iter_count));
          do_iterate new_vertexes))
end
